Admin

Define functions, directories, color palettes, inputs, etc here.

Load packages

library(sf)
library(measurements)
library(tidycensus)
library(tidyverse)
library(tmap)

Standard projection

proj <- 2246 # https://www.spatialreference.org/ref/epsg/2246/

Color Palettes

paletteY <- c("#F9F871","#FFD364","#FFAF6D","#FF8F80","#F87895", "D16BA5")
palette5 <- c("#25CB10", "#5AB60C", "#8FA108","#C48C04", "#FA7800")

Read/Prep Data

Louisville

Status Changes

rebalance_file <- paste(data_directory, 
                        "/Louisville-MDS-Status-Changes-2019Dec17.csv",
                        sep = "")

rebalance_data <- read_csv(rebalance_file)

Census

#census data
LV_Census <- 
  get_acs(geography = "tract", 
          variables = c("B01003_001", "B19013_001", 
                        "B02001_002", "B08013_001",
                        "B08012_001", "B08301_001", 
                        "B08301_010", "B01002_001",
                        "B08014_001", "B08014_002"), 
          year = 2018, 
          state = "KY", 
          geometry = TRUE, 
          county = c("Jefferson"),
          output = "wide") %>%
  rename(Total_Pop =  B01003_001E,
         Med_Inc = B19013_001E,
         Med_Age = B01002_001E,
         White_Pop = B02001_002E,
         Vehicle_own_pop = B08014_001E,
         No_vehicle = B08014_002E,
         Total_Travel_Time = B08013_001E,
         Num_Commuters = B08012_001E,
         Means_of_Transport_pop = B08301_001E,
         Total_Public_Trans = B08301_010E) %>%
  dplyr::select(Total_Pop, 
                Med_Inc, 
                White_Pop, 
                Total_Travel_Time,
                Means_of_Transport_pop, 
                Total_Public_Trans,
                Num_Commuters,
                Med_Age,
                Vehicle_own_pop,
                No_vehicle,
                GEOID, 
                geometry) %>%
  mutate(Percent_White = White_Pop / Total_Pop,
         Mean_Commute_Time = Total_Travel_Time / Num_Commuters,
         Percent_Taking_Public_Trans = Total_Public_Trans / Means_of_Transport_pop,
         Percent_vehicle_available = 1 - No_vehicle / Vehicle_own_pop) %>% 
  st_transform(proj)
## 
Downloading: 16 kB     
Downloading: 16 kB     
Downloading: 16 kB     
Downloading: 16 kB     
Downloading: 25 kB     
Downloading: 25 kB     
Downloading: 25 kB     
Downloading: 25 kB     
Downloading: 49 kB     
Downloading: 49 kB     
Downloading: 49 kB     
Downloading: 49 kB     
Downloading: 49 kB     
Downloading: 49 kB     
Downloading: 66 kB     
Downloading: 66 kB     
Downloading: 66 kB     
Downloading: 66 kB     
Downloading: 74 kB     
Downloading: 74 kB     
Downloading: 74 kB     
Downloading: 74 kB     
Downloading: 90 kB     
Downloading: 90 kB     
Downloading: 98 kB     
Downloading: 98 kB     
Downloading: 98 kB     
Downloading: 98 kB     
Downloading: 110 kB     
Downloading: 110 kB     
Downloading: 120 kB     
Downloading: 120 kB     
Downloading: 130 kB     
Downloading: 130 kB     
Downloading: 150 kB     
Downloading: 150 kB     
Downloading: 150 kB     
Downloading: 150 kB     
Downloading: 180 kB     
Downloading: 180 kB     
Downloading: 180 kB     
Downloading: 180 kB     
Downloading: 190 kB     
Downloading: 190 kB     
Downloading: 220 kB     
Downloading: 220 kB     
Downloading: 220 kB     
Downloading: 220 kB     
Downloading: 230 kB     
Downloading: 230 kB     
Downloading: 260 kB     
Downloading: 260 kB     
Downloading: 260 kB     
Downloading: 260 kB     
Downloading: 280 kB     
Downloading: 280 kB     
Downloading: 300 kB     
Downloading: 300 kB     
Downloading: 310 kB     
Downloading: 310 kB     
Downloading: 310 kB     
Downloading: 310 kB     
Downloading: 330 kB     
Downloading: 330 kB     
Downloading: 330 kB     
Downloading: 330 kB     
Downloading: 330 kB     
Downloading: 330 kB     
Downloading: 360 kB     
Downloading: 360 kB     
Downloading: 370 kB     
Downloading: 370 kB     
Downloading: 400 kB     
Downloading: 400 kB     
Downloading: 420 kB     
Downloading: 420 kB     
Downloading: 440 kB     
Downloading: 440 kB     
Downloading: 460 kB     
Downloading: 460 kB     
Downloading: 460 kB     
Downloading: 460 kB     
Downloading: 490 kB     
Downloading: 490 kB     
Downloading: 500 kB     
Downloading: 500 kB     
Downloading: 500 kB     
Downloading: 500 kB     
Downloading: 500 kB     
Downloading: 500 kB     
Downloading: 500 kB     
Downloading: 500 kB     
Downloading: 540 kB     
Downloading: 540 kB     
Downloading: 550 kB     
Downloading: 550 kB     
Downloading: 560 kB     
Downloading: 560 kB     
Downloading: 570 kB     
Downloading: 570 kB     
Downloading: 570 kB     
Downloading: 570 kB     
Downloading: 570 kB     
Downloading: 570 kB     
Downloading: 580 kB     
Downloading: 580 kB     
Downloading: 600 kB     
Downloading: 600 kB     
Downloading: 610 kB     
Downloading: 610 kB     
Downloading: 620 kB     
Downloading: 620 kB     
Downloading: 620 kB     
Downloading: 620 kB     
Downloading: 620 kB     
Downloading: 620 kB     
Downloading: 620 kB     
Downloading: 620 kB     
Downloading: 630 kB     
Downloading: 630 kB     
Downloading: 630 kB     
Downloading: 630 kB     
Downloading: 640 kB     
Downloading: 640 kB     
Downloading: 650 kB     
Downloading: 650 kB     
Downloading: 650 kB     
Downloading: 650 kB     
Downloading: 650 kB     
Downloading: 650 kB     
Downloading: 670 kB     
Downloading: 670 kB     
Downloading: 670 kB     
Downloading: 670 kB     
Downloading: 670 kB     
Downloading: 670 kB     
Downloading: 680 kB     
Downloading: 680 kB     
Downloading: 690 kB     
Downloading: 690 kB     
Downloading: 690 kB     
Downloading: 690 kB     
Downloading: 700 kB     
Downloading: 700 kB     
Downloading: 700 kB     
Downloading: 700 kB     
Downloading: 710 kB     
Downloading: 710 kB     
Downloading: 720 kB     
Downloading: 720 kB     
Downloading: 720 kB     
Downloading: 720 kB     
Downloading: 720 kB     
Downloading: 720 kB     
Downloading: 740 kB     
Downloading: 740 kB     
Downloading: 750 kB     
Downloading: 750 kB     
Downloading: 750 kB     
Downloading: 750 kB     
Downloading: 750 kB     
Downloading: 750 kB     
Downloading: 760 kB     
Downloading: 760 kB     
Downloading: 770 kB     
Downloading: 770 kB     
Downloading: 770 kB     
Downloading: 770 kB     
Downloading: 770 kB     
Downloading: 770 kB     
Downloading: 790 kB     
Downloading: 790 kB     
Downloading: 790 kB     
Downloading: 790 kB     
Downloading: 810 kB     
Downloading: 810 kB     
Downloading: 820 kB     
Downloading: 820 kB     
Downloading: 820 kB     
Downloading: 820 kB     
Downloading: 820 kB     
Downloading: 820 kB     
Downloading: 880 kB     
Downloading: 880 kB     
Downloading: 890 kB     
Downloading: 890 kB     
Downloading: 890 kB     
Downloading: 890 kB     
Downloading: 890 kB     
Downloading: 890 kB     
Downloading: 900 kB     
Downloading: 900 kB     
Downloading: 900 kB     
Downloading: 900 kB     
Downloading: 910 kB     
Downloading: 910 kB     
Downloading: 920 kB     
Downloading: 920 kB     
Downloading: 920 kB     
Downloading: 920 kB     
Downloading: 940 kB     
Downloading: 940 kB     
Downloading: 940 kB     
Downloading: 940 kB     
Downloading: 940 kB     
Downloading: 940 kB     
Downloading: 970 kB     
Downloading: 970 kB     
Downloading: 970 kB     
Downloading: 970 kB     
Downloading: 990 kB     
Downloading: 990 kB     
Downloading: 990 kB     
Downloading: 990 kB     
Downloading: 990 kB     
Downloading: 990 kB     
Downloading: 990 kB     
Downloading: 990 kB     
Downloading: 1 MB     
Downloading: 1 MB     
Downloading: 1 MB     
Downloading: 1 MB     
Downloading: 1 MB     
Downloading: 1 MB     
Downloading: 1 MB     
Downloading: 1 MB     
Downloading: 1 MB     
Downloading: 1 MB     
Downloading: 1 MB     
Downloading: 1 MB     
Downloading: 1.1 MB     
Downloading: 1.1 MB     
Downloading: 1.1 MB     
Downloading: 1.1 MB     
Downloading: 1.1 MB     
Downloading: 1.1 MB     
Downloading: 1.1 MB     
Downloading: 1.1 MB     
Downloading: 1.1 MB     
Downloading: 1.1 MB     
Downloading: 1.1 MB     
Downloading: 1.1 MB     
Downloading: 1.1 MB     
Downloading: 1.1 MB     
Downloading: 1.1 MB     
Downloading: 1.1 MB     
Downloading: 1.1 MB     
Downloading: 1.1 MB     
Downloading: 1.2 MB     
Downloading: 1.2 MB     
Downloading: 1.2 MB     
Downloading: 1.2 MB     
Downloading: 1.2 MB     
Downloading: 1.2 MB     
Downloading: 1.2 MB     
Downloading: 1.2 MB     
Downloading: 1.2 MB     
Downloading: 1.2 MB     
Downloading: 1.2 MB     
Downloading: 1.2 MB     
Downloading: 1.2 MB     
Downloading: 1.2 MB     
Downloading: 1.2 MB     
Downloading: 1.2 MB     
Downloading: 1.2 MB     
Downloading: 1.2 MB     
Downloading: 1.2 MB     
Downloading: 1.2 MB     
Downloading: 1.2 MB     
Downloading: 1.2 MB     
Downloading: 1.2 MB     
Downloading: 1.2 MB     
Downloading: 1.3 MB     
Downloading: 1.3 MB     
Downloading: 1.3 MB     
Downloading: 1.3 MB     
Downloading: 1.3 MB     
Downloading: 1.3 MB     
Downloading: 1.3 MB     
Downloading: 1.3 MB     
Downloading: 1.3 MB     
Downloading: 1.3 MB     
Downloading: 1.3 MB     
Downloading: 1.3 MB     
Downloading: 1.4 MB     
Downloading: 1.4 MB     
Downloading: 1.4 MB     
Downloading: 1.4 MB     
Downloading: 1.4 MB     
Downloading: 1.4 MB     
Downloading: 1.4 MB     
Downloading: 1.4 MB     
Downloading: 1.4 MB     
Downloading: 1.4 MB     
Downloading: 1.4 MB     
Downloading: 1.4 MB     
Downloading: 1.4 MB     
Downloading: 1.4 MB     
Downloading: 1.4 MB     
Downloading: 1.4 MB     
Downloading: 1.4 MB     
Downloading: 1.4 MB     
Downloading: 1.4 MB     
Downloading: 1.4 MB

Base Map

base_map <- st_read("https://opendata.arcgis.com/datasets/6e3dea8bd9cf49e6a764f7baa9141a95_30.geojson")

base_map_proj <- base_map %>% st_transform(proj)

Fishnet

1/10th of a square mile each

boundary <- st_union(base_map_proj) %>% st_sf()

cell_area <- conv_unit(0.5, from = "mi2", to = "ft2")
cell_size <- (cell_area * (2/3^0.5)) ^ 0.5 # the "cellsize" parameter is the distance between the centroids of each hexagonal cell.

lville_fishnet <- st_make_grid(boundary, cellsize = cell_size, square = FALSE) %>% 
  st_sf() %>% 
  mutate(fishnet_ID = row_number())

Explore and Visualize Data

Louisville

Distribution of Scooter Status Change Activities

activity_distro_plot <- rebalance_data %>% 
  ggplot(aes(x = reason)) +
  geom_bar(stat = "count", position = "identity") +
  facet_wrap(~ type, scales = "free") +
  coord_flip() +
  labs(x = "Reason for Status Change",
       y = "Count",
       title = "Distribution of Scooter Status Change Activities")

activity_distro_plot

Geographic Distribution of Status Change Activities

rebalance_data_sf <- st_as_sf(rebalance_data,
                              wkt = "location", 
                              crs = 4326)

rebalance_data_sf_proj <- rebalance_data_sf %>% 
  st_transform(proj)

rebalance_only <- rebalance_data_sf_proj %>% 
  filter(str_detect(reason, "rebalance"))
rebalance_only <- rebalance_only[base_map_proj,] #intersect data

Scooters tend to be rebalanced from all over Louisville to the waterfront and Old Louisville.

ggplot() +
  geom_sf(data = base_map_proj, fill = NA, color = "lightgray") +
  geom_sf(data = rebalance_only, 
          aes(color = reason),
          alpha = 0.1) +
  facet_wrap(~ reason) +
  theme_minimal()

rebalance_pickups <- rebalance_only %>% 
  dplyr::select(reason) %>% 
  filter(reason == "rebalance pick up")

rebalance_dropoffs <- rebalance_only %>% 
  dplyr::select(reason) %>% 
  filter(reason == "rebalance drop off")

Rebalance Pickups

tmap_mode("view")

tm_shape(rebalance_pickups %>% sample_n(10000)) +
  tm_dots(col = "red",
          alpha = 0.2)

Rebalance Dropoffs

tm_shape(rebalance_dropoffs %>% sample_n(10000)) +
  tm_dots(col = "blue",
          alpha = 0.2)
lville_fishnet2 <- lville_fishnet %>% 
  mutate(pickups = lengths(st_intersects(., rebalance_pickups)),
         dropoffs = lengths(st_intersects(., rebalance_dropoffs))) %>% 
  gather(key = "Event", value = "Count", pickups:dropoffs)

ggplot() +
  # geom_sf(data = base_map_proj, fill = NA, color = "lightgray") +
  geom_sf(data = lville_fishnet2, 
          aes(fill = log(Count + 1)),
          alpha = 1) +
  scale_fill_continuous(high = "#132B43", low = "#56B1F7") +
  facet_wrap(~ Event) +
  theme_minimal() +
  labs(subtitle = "Note these are log-transformed")

Census Variables

  • Percent White
  • Mean Commute Time
  • Percent Public Transit Riders
  • Percent with a Vehicle

histograms

LV_Census_2 <- LV_Census %>% 
  mutate(Percent_White_quintile = ntile(Percent_White, 5),
         Percent_Taking_Public_Trans_quintile = ntile(Percent_Taking_Public_Trans, 5),
         Percent_vehicle_quintile = ntile(Percent_vehicle_available, 5)) %>%
  dplyr::select(GEOID,
                Percent_White,
                Mean_Commute_Time,
                Percent_Taking_Public_Trans,
                Percent_vehicle_available,
                Percent_White_quintile,
                Percent_Taking_Public_Trans_quintile,
                Percent_vehicle_quintile
                ) %>%
  gather(key = "variable",
         value = "value",
         Percent_White:Percent_vehicle_quintile)

LV_Census_histogram <- LV_Census_2 %>% 
  filter(!str_detect(variable, "quintile")) %>% 
  ggplot(aes(x = value)) +
  geom_histogram(bins = 50) +
  facet_wrap(~ variable, 
             scales = "free")

LV_Census_histogram

maps by quintile

LV_Census_map <- ggplot() +
  geom_sf(data = LV_Census_2 %>% filter(str_detect(variable, "quintile")),
          aes(fill = value)) +
  scale_fill_continuous(high = "#132B43", low = "#56B1F7") +
  facet_wrap(~ variable, ncol = 1)

LV_Census_map